perm filename SC3B.FOR[ZZZ,LCS] blob
sn#439868 filedate 1979-05-08 generic text, type T, neo UTF8
SUBROUTINE RUN2(NRN)
INTEGER PL,PL4,COPYL
COMMON /PCIP/ PCH(27,33) /IPT/IPT(27,32) /JPREC/JPREC
C 2ND NUM IN IPT=NUMP+2. (NUMPY)
C PL SHOULD HAVE ABOUT NUMP+17
COMMON/P/P(30)/PL/PL(47)/NUMP/NUMP,NUMPX,NUMPY/IRX/IR1,IR2
1 /COPY/COPY(30) /COPYL/COPYL(30),IT(30)
COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20
COMMON /Q/ BNW(200),NWZ /INS/RINST(27),BG(60) /TYP/JOUT,LN
1 /ROFF/ROFF(27),RDEV(27),P1(27)
1 /VV/LIMIT,V(1) /A/NP(27),XT(27),FRM(80),INVIS(27)
1 /COFF/RREST(27),RNP(27)
C JPT MUST BE .LE.27*NUMPY !! ******KPAC(4) FOR PDP11*****
DIMENSION JPT(837),NCNT(27,32),KPAC(5)
1,ISC(7),MULT(7)
C WITH VX AT 70 AND FRM AT 80 OK FOR ONLY
C 40 LIT CHARS + 30 PARAMS PER INST.
C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
COMMON J,L /DUR/DUR(27) /KNT/KNT(27),BT,IREST,DF
1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG
1 ,VX(70),IAMP,K,KN,M,ML,SPACE
COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
1 Y,Z,FNAME,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,NL,RC,W,
1 ZZ,CHN,YY
1 /D/TF,AMPFAC,OP1,DURX,IXIN,FLNM
1 /INTC/NWZZ,IT3,NW,KODE,NPAR,LP,NPA,IBX,IZ,IA
1 /REALC/T,T1,BY,T6,T2,RD,TDUR,T4,AC
EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
1 (VX1,VX(1)),(PL4,PL(4)),(IPT,JPT)
1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
1 ,(VX5,VX(5)),(KPAC1,KPAC(1)),(KPAC2,KPAC(2)),
1 (KPAC3,KPAC(3)),(KPAC4,KPAC(4))
DATA B1X/'1X'/,FRM1/'(1XA'/,FRM2/'4, '/,COMMA/4H',',/,
1 BA4/'1XA4'/,BA1/'A1, '/,
1 BDOL/'$)'/,B2A/' 2F9.'/, NPRLN/8/,
1 B2B/'3, '/,B9/'F9.1'/,B8/'F8.3'/,BPRN/') '/,BLA/' '/
1, BCOM/', '/,RNDOFF/1000.0/,IBLA/' '/,PLAY/'PLAY'/,ISEMI/';'/
C********************CHANGE BA4 TO '1XA4' ************************
C******** ALSO FRM1 TO '(1XA' ---- ETC.!!!!!!!
C NPRLN IS NUMBER OF PARAMS TO BE PRINTED PER LINE.
DATA ISC/'C','D','E','F','G','A','B'/,N0/'0'/,ISS/'S'/
1,ISTAR/'*'/,KSLA/'/'/,MULT/'8','4','2',0,'2','4','8'/
EQUIVALENCE (FRM1,FRM(1)),(FRM2,FRM(2)),(FRM3,FRM(3)),
1 (FRM4,FRM(4)),(IFF,ISC(4))
IF(NRN.EQ.0)GO TO 500
1108 M=0
JC=0
CCHD=0
C NWZZ IS SET AT 3111 IN SORTR. CCHD IS FOR CHORD FEATURE.
CKL IF(NWZ)GO TO 1740
IF(NWZ.LT.0)GO TO 31
DO 740 K=1,NWZZ
X=BNW(K)
IF(X-.0001.GT.BT)GO TO 2740
IF(X.LE.BW)GO TO 2740
IF(BW.LT.0)GO TO 2740
IT(J)=IT(J)*10
NW=K
RETURN
CCC GO TO 600
2740 IF(X.LT.1000.)GO TO 740
IF(X-J*10000.NE.KNT(J)+1.)GO TO 740
X=BT+PR
NW=K
IBX=KNT(J)+1
IT(J)=-3
RETURN
CCC GO TO 600
740 CONTINUE
IT(J)=0
31 KL=1
2031 KNT(J)=KNT(J)+1
ICT=KNT(J)
C INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
NPA=NP(J)
PP1=P1(J)
IF(BT.GE.DUR(J))GO TO 5174
IF(IQ(J).EQ.0)GO TO 200
P2=-IQ(J)/1000.
IQ(J)=0
KNT(J)=-1
ICT=-1
C PRINTS REST AND KNT=-1 WHEN 1ST BG TIME IS >0
GO TO 4203
C IREST IS FLAG FOR RESTS
200 IREST=0
DF=1.
C DF=DUTY FACTOR
DO 2155 L=2,NPA
ISUB=0
C WHY DOES ISUB APPEAR AT 14700/5?
IDF=0
C IDF IS DUTY FACTOR FLAG
IJ=IPT(J,L)
3024 IF(IJ.LT.0)IJ=JPT(-IJ)
IF(IJ.LT.0)GO TO 3024
C FOLLOWS UP ON POINTERS TO POINTERS!
PM=1.
IF(IJ.GT.1)GO TO 2157
P(L)=0
GO TO 3207
2157 LN=IJ+2
NM=ABS(V(IJ-1))+LN-4
NL=V(IJ)
IF(NL.GT.-100)GO TO 272
IF(NL.GT.-200)GO TO 372
ISUB=-1
NL=NL+200
C FOR SUBROUTINE FLAG
372 IF(NL.GT.-100)GO TO 272
IDF=-1
NL=NL+100
C DEC.6,72 FINDS DUTY FACTOR PARAM
272 VIJ2=PARAM(V(IJ+1),KN)
C A PARAM NUM CAN APPEAR ANYWHERE A NORMAL NUM IS EXPECTED.
KIJ2=VIJ2
KN=NL/(-11)
IF(KN.EQ.0)GO TO 1100
GO TO (61,62,62,62,65,65,67,68),KN
1100 IF(KIJ2.EQ.1)GO TO 1200
ML=3
1900 KA=1
VX1=0
DO 1156 K=LN,NM,ML
X=PARAM(V(K),X)
C NOW % NUM MAY BE A PARAM. (E.G. P22 1,2 ETC.) X IS DUMMY ARG.
VX(KA+1)=X+VX(KA)
1156 KA=KA+1
X=RAN(IR1,IR2)
DO 1157 K=2,21
C LIMIT OF 20 DIFF. %'S OF RAN. SELECTION ON 2 POSSIBLE LINES.
IF(X.GT.VX(K))GO TO 1157
KL=K-1
IF(KN.EQ.7)GO TO 6157
GO TO 1400
1157 CONTINUE
1400 LN=IJ+3*KL
1462 RA=PARAM(V(LN),K)
IF(RA.EQ.-10000.)GO TO 4174
C FOR "FINE" IN RLIST
RB=PARAM(V(LN+1),K)
C FUNCTION PARAM CHECKS TO SEE IF WE SHOULD LOOK AT ANOTHER PARAMETER FOR DATA.
PAR=RAND(RA,RB)
1300 IF(NL.EQ.-1)GO TO 1155
PAR=IFIX(PAR)
PM=2.
C IF 2 THEN PRINTS A4
IF(PAR.GE.199.)IREST=-1
GO TO 1155
1200 PAR=PARAM(V(IJ+2),PAR)
CHECKS IF REFERING TO OTHER PARAM.
GO TO 1300
C NEXT IS FOR SUBROUTINE AND QUAD CALLS
61 IF(NL.LT.-12)GO TO 6100
601 IF(AMOD(V(IJ),1.0).EQ.0)GO TO 871
C FOUND 'MICRO'
CALL MICRO
GO TO 3208
871 X=P2
CALL SUBR
CC 7/74 NOW SET DUR(J) =0 IN SUBR IF(DF)GO TO 5174
C* OUT--COLGATE DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
IF(L.EQ.2)GO TO 4203
IF(X.EQ.P2)GO TO 3208
PP2=P2
PR=P2
GO TO 3208
C ABOVE IS FOR P2 CHANGES IN SUBROUTINE
C TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
C ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
C BE SET TO 'REAL TIME'.)
6100 X=PARAM(V(LN),Z)
C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
Y=ABS(X)
IF(BT.GE.Y)GO TO 2155
Z=PARAM(V(LN+1),Z)
C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
C JUMP IF 'TEMPO' CHANGE
IF(BT+ABS(P2).LT.Y-Z)GO TO 2155
1102 Z=P2
P2=Y-BT
IF(Z.LT.0.OR.X.LT.0)IREST=-1
PX2=P2
PP2=PP2/PR*P2
PR=P2
GO TO 2155
C FOLLOWING IS FOR STRINGS OF VALUES.
62 KL=NCNT(J,L)+1
IF(KL.GT.KIJ2)KL=1
IF(NL.EQ.-46)GO TO 677
IF(NL.NE.-36)GO TO 162
C THIS PART FOR STRINGS OF RAND SELECTION
677 LN=KL+IJ+1
KL=KL+1
IF(KL.GT.KIJ2)KL=1
NL=NL+45
C FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1. FOR NOTES, =9)
162 NCNT(J,L)=KL
IF(NL.GT.-22)GO TO 1462
C JUMP RAND SELECTION
PAR=PARAM(V(IJ+KL+1),K)
IF(K.NE.0)GO TO 1155
C JUMP IF REFERING TO ANOTHER PARAM. (I.E. K NOT = 0)
IF(KN.NE.3)GO TO 1155
IF(PAR.EQ.-10000.)GO TO 4174
PM=2.
IF(PAR.GT.300.)GO TO 777
IF(PAR.GE.1.)GO TO 877
IF(NL.NE.-33)GO TO 777
C NEXT FOR CHORD FEATURE
PAR=-PAR
CCHD=ABS(V(IJ+KL+2))
KL=KL+1
IF(KL.GT.KIJ2)KL=1
NCNT(J,L)=KL
JCHD=IJ
LCHD=L
GO TO 877
777 PM=3.
877 IF(PAR.EQ.199.)IREST=-1
GO TO 5155
65 W=-9900.-V(IJ-3)
C W=BG TIME OF MOVE.
X=ABS(V(IJ-1))
IF(NL.EQ.-56)GO TO 977
IF(NL.NE.-58)GO TO 771
977 PM=2.
771 Z=(BT-W)/VIJ2
C Z= % OF WAY THROUGH.
IF(Z.GT.1.)Z=1.
Y=PARAM(V(LN),Y)
IX=3
IF(X.EQ.7)IX=4
W=PARAM(V(IJ+IX),W)
IF(NL.LT.-58)GO TO 3205
PAR=(W-Y)*Z+Y
IF(X.EQ.7.)GO TO 1600
GO TO 255
C FOR "MOVX"
C THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
3205 PAR=RMOVX(W,Y,Z)
C SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
C THIS NEEDS WORK!
IF(X.NE.7.)GO TO 255
W=PARAM(V(IJ+5),W)
Y=PARAM(V(IJ+3),Y)
X=RMOVX(W,Y,Z)
GO TO 3206
C NEXT IS FOR MOVING RAND RANGES.
1600 W=PARAM(V(IJ+3),W)
C*********** BACK TO 65 IS NEW. FEB. 15,71
X=(PARAM(V(IJ+5),X)-W)*Z+W
3206 PAR=RAND(PAR,X)
255 IF(PAR.GT.-19999.0)GO TO 155
PAR=PARAM(PAR+10000.,Y)
C THIS FOR MOVP -- THE NUMS. ARE E.G. -19999.12, -19999.129
GO TO 155
67 LN=IJ+3
NM=LN+KIJ2-1
ML=1
GO TO 1900
C 7/74 **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
C ALSO DF. THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
C CHANGES. HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
C INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
6157 LN=V(LN-1)
DO 1068 K=1,KL
1068 IF(K.LT.KL)LN=LN+V(LN)+1
2068 PM=LN+1
PAR=LN+V(LN)
IF(PM.EQ.2)PAR=IFIX(PAR)
GO TO 5155
68 KL=NCNT(J,L)
IF(NL.NE.-1000)GO TO 680
IF(CCHD.GE.0)GO TO 2155
IF(NPA.LT.3)NPA=3
C NPA CAN =2 IN SOME CASES, THEN THE NEW CHORD NOTE WOULDN'T PRINT.
CCHD=0
KL=NCNT(J,LCHD)+1
X=V(JCHD+KL)
CKL IF(X.GE.0)GO TO 9203
IF(X.GE.0)GO TO 1170
NCNT(J,LCHD)=KL
CCHD=ABS(V(JCHD+KL+1))
CKL GO TO 9203
GO TO 1170
680 IF(KL.EQ.0)GO TO 774
IF(KL.NE.10000)GO TO 773
774 KL=KIJ2
773 PM=KL+1
PAR=PM+V(KL)-1
KL=PAR+1
IF(V(KL).NE.-10000.)GO TO 6174
KNT(J)=KNT(J)-1
DUR(J)=BT
C 'END' OR 'FINE' IN 'LIT' LIST.
6174 IF(V(KL).EQ.999.)KL=IJ+2
NCNT(J,L)=KL
GO TO 5155
155 IF(PM.EQ.2)PAR=IFIX(PAR)
C GETS RID OF UNWANTED DECIMALS
1155 IF(PAR.EQ.-10000.)GO TO 4174
C TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
5155 P(L)=PAR
3207 PL(L)=PM
IF(ISUB.LT.0)GO TO 601
IF(L.EQ.2)GO TO 4203
3208 IF(IDF.GE.0)GO TO 2155
DF=PAR
C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
IDF=0
2155 CONTINUE
GO TO 1170
4203 PR=P2
PX2=P2
C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
IF(T5.EQ.0)GO TO 7203
IF(IT3.LE.1)GO TO 6203
IF(BT.LT.TBG+TDUR)GO TO 6203
K=X+.5
3155 IT3=IT3+3
TBG=TBG+TDUR
TDUR=V(IT3)
IF(BT.GE.TBG+TDUR)GO TO 3155
T1=V(IT3+1)
T2=V(IT3+2)
CALL SQYY(AC,T1,T2,TDUR)
6203 RA=PR
IF(BT.EQ.TBG)XT(J)=T1
K=IT3
RC=0
KA=1
Z=TDUR+TBG-BT
X=T1
Y=T2
YY=AC
CHN=TBG
ZZ=TDUR
CALL ACCEL
8203 P2=RA*RD
7203 P2=P2*T4
X=ABS(P2*TF)
C P2 IS KEPT WITHOUT TF*
K=X+0.5
Y=ROFF(J)
Y=Y+K-X
IF(ABS(Y).LT.1.)GO TO 7155
X=1
IF(Y.LT.0)X=-X
K=K-X
Y=Y-X
C ROUND-OFF GAP WILL NOT EXCEED .001****.01 WITH NEW DAC!X?#@(MUS10)
C*********** FEB 17,71
7155 IF(P2.NE.0)GO TO 41710
WRITE(JTYPE,4171)RINST(J),P1(J)
IREST=-1
4171 FORMAT(/' ******** WARNING: P2 = 0 ******* ',A4,F)
41710 IF(P2.LT.0)K=-K
PP2=K/RNDOFF
ROFF(J)=Y
C AVOIDS ROUND-OFF PROBLEMS **** TO 1/100 (1/76)
C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!
C NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
CKL6155 IF(ICT)GO TO 9203
6155 IF(ICT.GE.0)GO TO 2155
1170 IF(BT.NE.0)GO TO 577
IF(J.EQ.1)GO TO 303
577 IF(IPT(J,1).EQ.0)GO TO 303
C NEXT FOR 'RR' = RANDOM RESTS
X=ALL(JPT,IPT(J,1))
Y=RAN(IR1,IR2)
C ABOVE IS SAME AS RAND(0.0, 1.0)
IF(Y-X.LT.0)IREST=-1
303 IF(IPT(J,NUMPX).EQ.0)GO TO 2303
C 'RD' = RANDOM DEVIATION. THIS BECOMES P31. IT CAN READ ANOTHER P NUM.
C NUMPX=NUMB. OF PARAMS +1
IF(ICT.LT.0)GO TO 2303
X=ALL(JPT,IPT(J,NUMPX))/2.
IF(PP2.GE.0)GO TO 615
IREST=-1
PP2=-PP2
615 Y=IFIX(RAND(-X,X)*RNDOFF+.5)/RNDOFF
C ROUNDS TO 1/100 OR 1/1000 -- RNDOFF
W=RDEV(J)
IF(ABS(W+Y).GT.X)Y=-Y
C TOTAL RAND DEV.(RDEV) WON'T EXCEED P100
RDEV(J)=W+Y
PP2=PP2+Y
C SET P100 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
2303 IF(IREST.LT.0)GO TO 2022
IF(PP2.LT.0)GO TO 2022
ZPAR=PP1
P1(J)=PP1+PP2
C ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
RIN=RINST(J)
2021 IF(PP1.LT.OP1)GO TO 2612
IF(INVIS(J).LT.0)GO TO 2170
C ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
IF(INONLY.GT.0)GO TO 1204
4021 IF(P(NPA).NE.COPY(NPA))GO TO 5021
IF(PL(NPA).NE.COPYL(NPA))GO TO 5021
IF(PL(NPA).GT.2)GO TO 5021
C 'LIT' DATA WILL ALWAYS PRINT BUT NOT NOTES OR FUNCS.
NPA=NPA-1
IF(NPA.GT.2)GO TO 4021
5021 DO 1304 K=3,NPA
COPYL(K)=PL(K)
1304 COPY(K)=P(K)
1204 IF(PL4.NE.1)GO TO 2170
P4=P4*AMPFAC
W=0
RNP(J)=P4
DO 1021 K=1,NINS
1021 IF(P1(K).GT.PP1)W=W+RNP(K)
IF(W-RAMP.LE.0)GO TO 2170
RAMP=W
AMPTIM=PP1
2170 IF(MX.EQ.3)GO TO 2612
PP1=PP1-OP1
IF(MZ.NE.-1)GO TO 5170
IF(SPACE.GE.PP1)GO TO 5170
C PUTS SPACES BETWEEN NOTES .GT. .05( APART
IF(INONLY.LT.0)WRITE(JOUT,902)
SPACE=PP1+.05
5170 ML=NPRLN
IF(NPA.LT.NPRLN)ML=NPA
MLX=3
NL=2
IEND=0
K=INVIS(J)
IF(K.EQ.0)GO TO 3170
IF(K.EQ.-1)GO TO 9170
IEND=-1
C THIS DELETES END PRINTOUT ( ;PRINT P1 ETC.)
IF(K.EQ.-2)GO TO 3170
C -1=INVIS FRONT, -2=INVIS END -3=BOTH
9170 RIN=0
C NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
C NEXT CREATES FORMAT DATA IN IFM ARRAY.
3029 KL=3
GO TO 4170
3170 IF(J.EQ.INONLY)GO TO 775
IF(INONLY.GE.0)GO TO 2612
775 VX1=PP1
IF(IPT(J,NUMPY).EQ.0)GO TO 1303
C NUMPY=NUMP+2
DF=ALL(JPT,IPT(J,NUMPY))
C FOR 'DF'=DUTY FACTOR. A SINGLE NUM. OR READ A PARAM. (NO TEMPO AFFECT.)
1303 IF(DF.GT.0)GO TO 6170
VX2=PP2+DF
IF(VX2.LE.0)VX2=PP2/2
C NO NEG. TIME VALUES ALLOWED.
C NEG. DF= FIXED REST AREA BEFORE NEXT ATTACK.
GO TO 7170
6170 IF(DF.LT.100)GO TO 8170
C DF+100=FIXED NOTE DUR. NOT.GT.PP2 7/74 COLGATE -AND BELOW
C DF+1000=FIXED TIME OF OVERLAP 3/77 (CHNG THIS TO 300 SOMEDAY!)
IF(DF.GT.1000)GO TO 8171
VX2=DF-100.
IF(VX2.GT.PP2)VX2=PP2
C DF+200= FIXED DURATION WITHOUT REGARD TO OVERLAPS
IF(DF.GT.200)VX2=DF-200.
GO TO 7170
C*** NEXT FOR DF>1000 ****!!!! SWITCH THIS FEATURE WITH ORD. DF SOMEDAY!!!!
8171 VX2=PP2+DF-1000.
GO TO 7170
8170 VX2=PP2*DF
7170 FRM3=B2A
FRM4=B2B
KL=5
IF(NPA.LT.3)GO TO 2121
4170 NL=2
DO 1121 K=MLX,ML
X=P(K)
L=PL(K)
IF(L-2)321,521,621
C L=1 NUMBS, =2 NOTES,FUNCS, =3 LITS.
321 IF(X.GE.0)GO TO 4211
FRM(KL)=COMMA
NL=NL+1
KL=KL+1
4211 FRM(KL)=B8
IF(ABS(X).GE.1000.0)FRM(KL)=B9
FRM(KL+1)=BCOM
KL=KL+1
NL=NL+1
421 VX(KL-NL)=X
GO TO 1121
521 LN=X
KPAC1=IBLA
KPAC4=IBLA
C MOST ITEMS WILL HAVE LEADING AND TRAILING BLANKS.
IF(LN.LT.200)GO TO 2621
LN=LN-200
CC IF(LN.LT.10)IVX=IF0+LN*2
CC IF(LN.GE.10)IVX=IF10 + 256*(LN/10) + 2*MOD(LN,10)
C FOR FUNC NUMS. CAN NOW BE F0→F99. (RVX AND RVX ARE EQUIV.)
KPAC2=IFF
IF(LN.LT.10)GO TO 5521
KPAC3=N0+536870912*(LN/10)
C11 KPAC3=N0+LN/10
C GETS RIGHT HAND DIGIT
KPAC4=N0+536870912*MOD(LN,10)
C11 KPAC4=N0+MOD(LN,10)
GO TO 4521
C11 5521 KPAC3=N0+LN
5521 KPAC3=N0+LN*536870912
KPAC4=IBLA
4521 CALL PACKX(RVX,KPAC)
VX(KL-NL)=RVX
GO TO 42
2621 KA=LN-1
IOCT=KA/12
LN=MOD(KA,12)+1
KA=LN
IF(KA.LT.6)KA=KA-1
KPAC2=ISC(KA/2+1)
C NOW WE HAVE THE LETTER NAME OF THE NOTE. (NO ACCID.)
IF(LN.NE.2.AND.LN.NE.4.AND.LN.NE.7.AND.LN.NE.9.AND.
1 LN.NE.11)GO TO 2521
C CHECK FOR CS, DS, FS, GS, AS
1521 KPAC1=KPAC2
KPAC2=ISS
2521 IF(IOCT-4)6521,8521,3521
C NEXT FOR CENTRAL OCTAVE
8521 KPAC3=IBLA
GO TO 4521
3521 KPAC3=ISTAR
7521 KPAC4=MULT(IOCT)
C GETS OCTAVE FACTOR (/8, /4, /2, 0, *2, *4, *8)
GO TO 4521
6521 KPAC3=KSLA
GO TO 7521
621 IF(L.GT.3)GO TO 721
VX(KL-NL)=X
C ABOVE LETS A4 WD BE USED IN SUBR BY SETTING IPL(N)=3.
42 FRM(KL)=BA4
KL=KL+1
NL=NL+1
FRM(KL)=BCOM
C CREATES '1XA4,'
GO TO 1121
721 LN=X
FRM(KL)=B1X
NL=NL+1
DO 821 M=1,LN-L+1
C FOR 'LIT' STRINGS
KL=KL+1
VX(KL-NL)=V(L-1+M)
821 FRM(KL)=BA1
1121 KL=KL+1
C NO MORE THAN 80 ITEMS IN FORMAT.
2121 IF(KL.LE.80)GO TO 21211
21212 FORMAT(' ERROR! TOO MANY LIT. ITEMS')
WRITE(JTYPE,21212)
21211 DO 921 M=KL+1,80
921 FRM(M)=BLA
FRM(KL)=BPRN
1921 L=KL-NL-1
IF(MX.LT.0)WRITE(ID20,FRM)RIN,(VX(K),K=1,L)
IF(MZ.GE.0)GO TO 3023
IF(ML.GE.NPA)FRM(KL)=BDOL
WRITE(JOUT,FRM),RIN,(VX(K),K=1,L)
3023 IF(ML.GE.NPA)GO TO 3021
MLX=ML+1
ML=ML+NPRLN
IF(ML.GT.NPA)ML=NPA
RIN=BLA
GO TO 3029
3021 IF(IEND.LT.0)GO TO 3011
C IEND=-1 FOR INVIS. ENDING. (ALLOWS EXTENTION OF P LIST.)
IF(MX.LT.0)WRITE(ID20,3616)RINST(J),ICT
3011 IF(MZ.LT.0)WRITE(JOUT,8902),J,RINST(J),ICT,BT
2612 PP1=ZPAR
GO TO 21
902 FORMAT(1XA4/)
8902 FORMAT('+;<'I2,1XA4,I4,' >',F7.2)
3616 FORMAT('; < ',A4,I4)
CC3616 FORMAT(';PRINT P1;< ',A4,I4)
C PRINTS RESTS
2022 PP2=ABS(PP2)
C IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2.
C FOR RESTS IN SEQS. TYPE -DUR.
C WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
C RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
RNP(J)=0
P1(J)=PP1+PP2
C STORES NEXT P1 TIME FOR THIS INST.
IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21
X=PP1-OP1
IF(A.GE.X)GO TO 121
WRITE(JOUT,902)
A=X+.05
C NEXT PRINTS A REST INDICATION
121 IF(INONLY.LT.0.OR.J.EQ.INONLY)WRITE(JOUT,1110),RINST(J),X
1 ,PP2,J,RINST(J),ICT,BT
21 IF(CCHD.EQ.0)GO TO 122
C NEXT FOR CHORDS
P3=CCHD
L=LCHD
NL=-1000
CCHD=-CCHD
IJ=JCHD
GO TO 68
4174 KNT(J)=KNT(J)-1
C TO GET PROPER NOTE COUNT AFTER 'FINE' WAS FOUND.
GO TO 5174
122 PR=ABS(PR)
BG(J)=BT+PR
IF(ICT.EQ.DUR(J)-10000.)GO TO 5174
IF(BG(J).LT.DUR(J))GO TO 500
5174 BG(J)=19999.
DO 3174 K=1,NINS
C INSERTS CAN'T FOLLOW LAST REGULAR NOTE.
C (ADD REST IF INSERT AT END IS NEEDED.)
3174 IF(BG(K).LT.19999.)GO TO 500
GO TO 175
C CHOOSES INST WITH NEXT BEGIN TIME.
500 J=1
BW=BT
NL=NINS
DO 22 K=2,NL
22 IF(BG(J).GT.BG(K))J=K
IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
J=1
DO 5022 K=2,NINS
X=P1(J)
Y=P1(K)+.0001
C LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
IF(BG(J).EQ.19999.)X=19999.
IF(BG(K).EQ.19999.)Y=19999.
5022 IF(X.GT.Y)J=K
C ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
3022 BT=BG(J)
IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
IF(KNT(J).GT.0)GO TO 1022
IF(KNT(J).EQ.0)P1(J)=0
IF(KNT(J).EQ.-1)KNT(J)=0
C N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0
1022 IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108
T4=T2
T5=0
T6=10000.
GO TO 1108
1175 FORMAT('+',A4,'=',F7.2,'"',I4,' NTS.',4X,$)
C*1175 FORMAT('+',A5,'=',F7.2,3X,$)
1109 FORMAT(' FINISH; < ',A4,'.DAT'/)
1110 FORMAT(' <',A4,2F8.2,2X,'******* REST <'I2,1XA4,I4,F11.2)
1603 FORMAT(' AMPL. FACTOR=',F5.2,', P4 MAX.AMP.=',F9.2,', AT TIME='
1,F8.3)
175 IF(MZ.LT.0)WRITE(JOUT,1109),FNAME
IF(MX.GE.0)GO TO 4175
WRITE(ID20,1109),FNAME
WRITE(JTYPE,604)
604 FORMAT(/' ***** DATA HAS BEEN WRITTEN ON DISK *****'/)
603 FORMAT(' TOTAL DURS: ',$)
4175 WRITE(JOUT,1603),AMPFAC,RAMP,AMPTIM
WRITE(JOUT,603)
5175 IJ=0
Y=0
DO 2175 K=1,NINS
X=P1(K)-OP1
IF(X.GT.Y)Y=X
J=KNT(K)
IJ=IJ+J
6175 WRITE(JOUT,1175),RINST(K),X,J
2175 CONTINUE
IF(NINS.GT.1)WRITE(JOUT,8175)IJ,Y
8175 FORMAT(/' TOTAL NOTES =',I5,F8.2,'"')
1023 FORMAT(/' < ',A4,'.DAT -- RANDOM NUMBER=',I6/1X2A4)
3175 WRITE(JTYPE,1023)FNAME,IXIN
CALL EXIT
END